home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / prog / sndcaps.zip / SNDCAPS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-17  |  10KB  |  304 lines
  1. { Windows 3.1 Sound board detection and capabilities }
  2.  
  3. program SndCaps;
  4.  
  5. uses Objects,OWindows,ODialogs,WinTypes,WinPRocs,Win31,Strings,MMSystem;
  6.  
  7. {$R SNDCAPS.RES }
  8.  
  9. const
  10.      cm_About = 999;
  11.      id_MidiBtn = 198;
  12.      id_ListBox = 102;
  13.  
  14. type
  15.     pMidiDlg = ^tMidiDlg;
  16.     tMidiDlg = object(tDialog)
  17.                  procedure SetUpWindow; virtual;
  18.                end;
  19.  
  20.     pMainDlg = ^tMainDlg;
  21.     tMainDlg = object(TDlgWindow)
  22.                  MidiPB : pButton;
  23.                  NumInDevs,NumOutDevs : word;
  24.                  NumOutMidi,NumInMidi : word;
  25.                  constructor Init(Aparent : pWindowsObject; AName : PChar);
  26.                  procedure SetUpWindow; virtual;
  27.                  function GetClassName : PChar; virtual;
  28.                  procedure GetWindowClass(var AWndClass : tWndClass);
  29.                            virtual;
  30.                  procedure DoAbout(var Msg : TMEssage);
  31.                            virtual cm_First + cm_About;
  32.                  procedure FillDialog;
  33.                  procedure DevSelect(var Msg : TMessage);
  34.                            virtual id_First+ id_ListBox;
  35.                  procedure ShowMidi(var Msg : TMessage);
  36.                            virtual id_First + id_MidiBtn;
  37.                end;
  38.  
  39.     tApp = object(TApplication)
  40.              BWCC : THandle;
  41.              constructor Init(AName : pChar);
  42.              procedure InitMainWindow; virtual;
  43.              destructor Done; virtual;
  44.            end;
  45.  
  46. var
  47.     CurDev : word;
  48.  
  49. constructor tApp.Init;
  50.  
  51.   begin
  52.     inherited init(AName);
  53.     BWCC := LoadLibrary('C:\WINDOWS\SYSTEM\BWCC.DLL');
  54.     if BWCC < 32 then
  55.     begin
  56.       MessageBox(0,'Cannot find BWCC.DLL!','Sound Capabilities',mb_OK);
  57.       exit;
  58.     end;
  59.   end;
  60.  
  61. destructor tApp.Done;
  62.  
  63.   begin
  64.     FreeLibrary(BWCC);
  65.     inherited Done;
  66.   end;
  67.  
  68.  
  69. procedure tApp.InitMainWindow;
  70.  
  71.   begin
  72.     MainWindow := new(pMainDlg,Init(nil,PChar(100)));
  73.   end;
  74.  
  75. constructor tMainDlg.Init;
  76.  
  77.   begin
  78.     inherited Init(AParent,AName);
  79.     MidiPB := new(pButton,InitResource(@Self,id_MidiBtn));
  80.   end;
  81.  
  82. procedure tMainDlg.FillDialog;
  83.  
  84.   var
  85.      i : word;
  86.      OutCaps : tWaveOutCaps;
  87.      InCaps : tWaveInCaps;
  88.  
  89.   begin
  90.     NumOutDevs := WaveOutGetNumDevs;
  91.     NumInDevs := WaveInGetNumDevs;
  92.     for i := 0 to NumOutDevs - 1 do
  93.     begin
  94.       fillchar(OutCaps,sizeof(OutCaps),0);
  95.       WaveOutGetDevCaps(i,@OutCaps,sizeof(OutCaps));
  96.       SendDlgItemMsg(102,lb_AddString,0,longint(@(OutCaps.szPName)));
  97.     end;
  98.     for i := 0 to NumInDevs - 1 do
  99.     begin
  100.       fillchar(InCaps,sizeof(InCaps),0);
  101.       WaveInGetDevCaps(i,@InCaps,sizeof(InCaps));
  102.       SendDlgItemMsg(102,lb_AddString,0,longint(@(InCaps.szPName)));
  103.     end;
  104.   end;
  105.  
  106. procedure tMainDlg.DevSelect;
  107.  
  108.   var
  109.      CurSel : word;
  110.      Formats,Controls : longint;
  111.      Channels : word;
  112.      DevIn : boolean;
  113.      OutCaps : tWaveOutCaps;
  114.      InCaps : tWaveInCaps;
  115.      Major,Minor : string;
  116.      Buffer : array[0..4] of char;
  117.  
  118.   begin
  119.     if Msg.lParamHi = lbn_SelChange then
  120.     begin
  121.       for CurDev := 200 to 205 do
  122.         SendDlgItemMsg(CurDev,bm_SetCheck,0,0);
  123.       for CurDev := 300 to 305 do
  124.         SendDlgItemMsg(CurDev,bm_SetCheck,0,0);
  125.       for CurDev := 400 to 404 do
  126.         SendDlgItemMsg(CurDev,bm_SetCheck,0,0);
  127.  
  128.       DevIn := FALSE;
  129.       CurSel := SendDlgItemMsg(102,lb_GetCurSel,0,0);
  130.       if CurSel > (NumOutDevs - 1) then
  131.       begin
  132.         CurSel := CurSel - NumOutDevs;
  133.         DevIn := TRUE;
  134.       end;
  135.       CurDev := CurSel;
  136.       case DevIn of
  137.         FALSE : begin
  138.                   WaveOutGetDevCaps(Curdev,@OutCaps,sizeof(OutCaps));
  139.                   Formats := OutCaps.dwFormats;
  140.                   Controls := OutCaps.dwSupport;
  141.                   Channels := OutCaps.wChannels;
  142.                   str(Hi(OutCaps.vDriverVersion),Major);
  143.                   str(Lo(OutCaps.vDriverVersion),Minor);
  144.                   Major := Major + '.' + Minor;
  145.                   StrPCopy(Buffer,Major);
  146.                   SendDlgItemMsg(500,wm_SetText,0,longint(@Buffer));
  147.                   SendDlgItemMsg(501,wm_SetText,0,longint(@(OutCaps.szPName)));
  148.                   StrCopy(Buffer,'Output Formats');
  149.                   SendDlgItemMsg(199,wm_SetText,0,longint(@Buffer));
  150.                 end;
  151.          TRUE : begin
  152.                   WaveInGetDevCaps(CurDev,@InCaps,sizeof(InCaps));
  153.                   Formats := Incaps.dwFormats;
  154.                   Channels := InCaps.wChannels;
  155.                   Controls := 0;
  156.                   str(Hi(InCaps.vDriverVersion),Major);
  157.                   str(Lo(InCaps.vDriverVersion),Minor);
  158.                   Major := Major + '.' + Minor;
  159.                   StrPCopy(Buffer,Major);
  160.                   SendDlgItemMsg(500,wm_SetText,0,longint(@Buffer));
  161.                   SendDlgItemMsg(501,wm_SetText,0,longint(@(InCaps.szPName)));
  162.                   StrCopy(Buffer,'Input Formats');
  163.                   SendDlgItemMsg(199,wm_SetText,0,longint(@Buffer));
  164.                 end;
  165.       end;
  166.       if Formats and WAVE_FORMAT_1M08 = WAVE_FORMAT_1M08 then
  167.         SendDlgItemMsg(200,bm_SetCheck,1,0);
  168.       if Formats and WAVE_FORMAT_1M16 = WAVE_FORMAT_1M16 then
  169.         SendDlgItemMsg(201,bm_SetCheck,1,0);
  170.       if Formats and WAVE_FORMAT_2M08 = WAVE_FORMAT_2M08 then
  171.         SendDlgItemMsg(202,bm_SetCheck,1,0);
  172.       if Formats and WAVE_FORMAT_2M16 = WAVE_FORMAT_2M16 then
  173.         SendDlgItemMsg(203,bm_SetCheck,1,0);
  174.       if Formats and WAVE_FORMAT_4M08 = WAVE_FORMAT_4M08 then
  175.         SendDlgItemMsg(204,bm_SetCheck,1,0);
  176.       if Formats and WAVE_FORMAT_4M16 = WAVE_FORMAT_4M16 then
  177.         SendDlgItemMsg(205,bm_SetCheck,1,0);
  178.  
  179.       if Formats and WAVE_FORMAT_1S08 = WAVE_FORMAT_1S08 then
  180.         SendDlgItemMsg(300,bm_SetCheck,1,0);
  181.       if Formats and WAVE_FORMAT_1S16 = WAVE_FORMAT_1S16 then
  182.         SendDlgItemMsg(301,bm_SetCheck,1,0);
  183.       if Formats and WAVE_FORMAT_2S08 = WAVE_FORMAT_2S08 then
  184.         SendDlgItemMsg(302,bm_SetCheck,1,0);
  185.       if Formats and WAVE_FORMAT_2S16 = WAVE_FORMAT_2S16 then
  186.         SendDlgItemMsg(303,bm_SetCheck,1,0);
  187.       if Formats and WAVE_FORMAT_4S08 = WAVE_FORMAT_4S08 then
  188.         SendDlgItemMsg(304,bm_SetCheck,1,0);
  189.       if Formats and WAVE_FORMAT_4S16 = WAVE_FORMAT_4S16 then
  190.         SendDlgItemMsg(305,bm_SetCheck,1,0);
  191.  
  192.       if Controls and WAVECAPS_PITCH = WAVECAPS_PITCH then
  193.         SendDlgItemMsg(400,bm_SetCheck,1,0);
  194.       if Controls and WAVECAPS_PLAYBACKRATE = WAVECAPS_PLAYBACKRATE then
  195.         SendDlgItemMsg(401,bm_SetCheck,1,0);
  196.       if Controls and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
  197.         SendDlgItemMsg(402,bm_SetCheck,1,0);
  198.       if Controls and WAVECAPS_LRVOLUME = WAVECAPS_LRVOLUME then
  199.       begin
  200.         SendDlgItemMsg(403,bm_SetCheck,1,0);
  201.         SendDlgItemMsg(404,bm_SetCheck,1,0);
  202.       end;
  203.       str(Channels,Major); StrPCopy(Buffer,Major);
  204.       SendDlgItemMsg(210,wm_SetText,0,longint(@Buffer));
  205.       NumOutMidi := MidiOutGetNumDevs;
  206.       NumInMidi := MidiInGetNumDevs;
  207.       if (NumOutMidi > 0) or (NumInMidi > 0) then
  208.       begin
  209.         MidiPB^.Show(sw_Show);
  210.       end;
  211.     end;
  212.   end;
  213.  
  214. procedure tMainDlg.ShowMidi;
  215.  
  216.   begin
  217.     Application^.ExecDialog(new(pMidiDlg,Init(@Self,PChar(102))));
  218.   end;
  219.  
  220. procedure tMidiDlg.SetUpWIndow;
  221.  
  222.   var
  223.      MidiOutCaps : tMidiOutCaps;
  224.      Major,Minor : string;
  225.      Buffer : array[0..50] of char;
  226.      i : word;
  227.  
  228.   begin
  229.     MidiOutGetDevCaps(CurDev,@MidiOutCaps,sizeof(MidiOutCaps));
  230.     with MidiOutCaps do
  231.     begin
  232.       str(Hi(vDriverVersion),Major);
  233.       str(Lo(vDriverVersion),Minor);
  234.       Major := Major + '.' + Minor;
  235.       StrPCopy(Buffer,Major);
  236.       SendDlgItemMsg(103,wm_SetText,0,longint(@Buffer));
  237.       SendDlgItemMsg(105,wm_SetText,0,longint(@(szPName)));
  238.       if wTechnology and MOD_MIDIPORT = MOD_MIDIPORT then
  239.         SendDlgItemMsg(200,bm_SetCheck,1,0);
  240.       if wTechnology and MOD_SQSYNTH = MOD_SQSYNTH then
  241.         SendDlgItemMsg(201,bm_SetCheck,1,0);
  242.       if wTechnology and MOD_FMSYNTH = MOD_FMSYNTH then
  243.         SendDlgItemMsg(202,bm_SetCheck,1,0);
  244.       if wTechnology and MOD_MAPPER = MOD_MAPPER then
  245.         SendDlgItemMsg(203,bm_SetCheck,1,0);
  246.       if dwSupport and MIDICAPS_CACHE = MIDICAPS_CACHE then
  247.         SendDlgItemMsg(300,bm_SetCheck,1,0);
  248.       if dwSupport and MIDICAPS_VOLUME = MIDICAPS_VOLUME then
  249.         SendDlgItemMsg(301,bm_SetCheck,1,0);
  250.       if dwSupport and MIDICAPS_LRVOLUME = MIDICAPS_LRVOLUME then
  251.       begin
  252.         SendDlgItemMsg(302,bm_SetCheck,1,0);
  253.         SendDlgItemMsg(303,bm_SetCheck,1,0);
  254.       end;
  255.       str(wVoices,Major); StrPCopy(Buffer,Major);
  256.       SendDlgItemMsg(110,wm_SetText,0,longint(@Buffer));
  257.       str(wNotes,Major); StrPCopy(Buffer,Major);
  258.       SendDlgItemMsg(111,wm_SetText,0,longint(@Buffer));
  259.       fillchar(buffer,sizeof(Buffer),'0');
  260.       Buffer[16] := #0;
  261.       for i := 0 to 15 do
  262.         if (wChannelMask and i) = i then Buffer[i] := '1';
  263.       SendDlgItemMsg(112,wm_SetText,0,longint(@Buffer));
  264.     end;
  265.   end;
  266.  
  267. procedure tMainDlg.SetUpWIndow;
  268.  
  269.   begin
  270.     inherited SetUpWindow;
  271.     PostMessage(HWindow,wm_Command,cm_About,0);
  272.     MidiPB^.Show(sw_Hide);
  273.     FillDialog;
  274.   end;
  275.  
  276. function tMainDlg.GetClassName : PChar;
  277.  
  278.   begin
  279.     GetClassName := 'bordlg_SoundCaps';
  280.   end;
  281.  
  282. procedure tMainDlg.GetWindowClass;
  283.  
  284.   begin
  285.     inherited GetWindowClass(AWndClass);
  286.     AWndClass.hIcon := LoadIcon(HInstance,PChar(100));
  287.   end;
  288.  
  289. procedure tMainDlg.DoAbout;
  290.  
  291.   begin
  292.     Application^.ExecDialog(new(pDialog,Init(@Self,PChar(101))));
  293.   end;
  294.  
  295. var
  296.    TheApp : tApp;
  297.  
  298. begin
  299.   TheAPp.Init('SNDCAPS');
  300.   TheApp.Run;
  301.   TheApp.DOne;
  302. end.
  303.  
  304.